mirror-github-bspeice/apophysis
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added gradient drawing in a tooltip form in the gradient browser.

Browse Source
This commit is contained in:
utak3r 2005-05-02 18:23:55 +00:00
parent 8cc8693bc2
commit 00296cfd95
2 changed files with 88 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
2.10/Source/Browser.dfm
View File

@ -73,7 +73,9 @@ object GradientBrowser: TGradientBrowser
LargeImages = LargeImages
ReadOnly = True
RowSelect = True
ParentShowHint = False
PopupMenu = PopupMenu
ShowHint = True
SmallImages = SmallImages
SortType = stText
TabOrder = 0
@ -81,6 +83,7 @@ object GradientBrowser: TGradientBrowser
OnChange = ListViewChange
OnDblClick = SpeedButton1Click
OnEdited = ListViewEdited
OnInfoTip = ListViewInfoTip
OnKeyPress = ListViewKeyPress
end
end
@ -875,4 +878,9 @@ object GradientBrowser: TGradientBrowser
E00001FF10022F031F022F0320FFFF0000000000000000000000000000000000
000000000000}
end
object TooltipTimer: TTimer
OnTimer = TooltipTimerTimer
Left = 8
Top = 52
end
end

80
2.10/Source/Browser.pas
View File

@ -26,6 +26,7 @@ uses
const
PixelCountMax = 32768;
PaletteTooltipTimeout = 1500;
type
TGradientBrowser = class(TForm)
@ -43,6 +44,7 @@ type
pnlControls: TPanel;
OpenDialog: TOpenDialog;
LargeImages: TImageList;
TooltipTimer: TTimer;
procedure ListViewChange(Sender: TObject; Item: TListItem;
Change: TItemChange);
procedure FormCreate(Sender: TObject);
@ -56,6 +58,9 @@ type
procedure SpeedButton1Click(Sender: TObject);
procedure ListViewKeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListViewInfoTip(Sender: TObject; Item: TListItem;
var InfoTip: String);
procedure TooltipTimerTimer(Sender: TObject);
private
procedure DrawPalette;
procedure Apply;
@ -505,5 +510,80 @@ begin
end;
end;
procedure TGradientBrowser.ListViewInfoTip(Sender: TObject;
Item: TListItem; var InfoTip: String);
var
i, j: integer;
Row: pRGBTripleArray;
Bitmap: TBitmap;
pal: TColorMap;
EntryStrings, FStrings: TStringList;
rect: TRect;
begin
BitMap := TBitMap.create;
Bitmap.PixelFormat := pf24bit;
BitMap.Width := 256;
BitMap.Height := 100;
FStrings := TStringList.Create;
EntryStrings := TStringList.Create;
try
if Lowercase(ExtractFileExt(filename)) = '.map' then
begin
pal := LoadFractintMap(filename);
end
else
begin
Identifier := Item.Caption;
FStrings.LoadFromFile(Filename);
for i := 0 to FStrings.count - 1 do
if Pos(Lowercase(Item.Caption) + ' ', Trim(Lowercase(FStrings[i]))) = 1 then break;
EntryStrings.Add(FStrings[i]);
repeat
inc(i);
EntryStrings.Add(FStrings[i]);
until Pos('}', FStrings[i]) <> 0;
pal := CreatePalette(EntryStrings.Text);
end;
finally
EntryStrings.Free;
FStrings.Free;
end;
for j := 0 to Bitmap.Height - 1 do
begin
Row := Bitmap.Scanline[j];
for i := 0 to Bitmap.Width - 1 do
begin
with Row[i] do
begin
rgbtRed := pal[i][0];
rgbtGreen := pal[i][1];
rgbtBlue := pal[i][2];
end
end
end;
rect.TopLeft := Item.Position;
rect.BottomRight.X := rect.TopLeft.X + 100;
rect.BottomRight.Y := rect.TopLeft.Y + 16;
with ListView do
begin
Canvas.Rectangle(Rect);
//Canvas.TextOut(Rect.Left, Rect.Top, Item.Caption);
//Rect.Left := (Rect.Left + rect.Right) div 3;
Canvas.StretchDraw(Rect, Bitmap);
end;
BitMap.Free;
InfoTip := '';
TooltipTimer.Interval := PaletteTooltipTimeout;
TooltipTimer.Enabled := true;
end;
procedure TGradientBrowser.TooltipTimerTimer(Sender: TObject);
begin
ListView.Repaint;
TooltipTimer.Enabled := false;
end;
end.