1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254 |
- {
- $Id$
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 by Florian Klaempfl
- This file implements the win32 gui support for the graph unit
- See the file COPYING.FPC, included in this distribution,
- for details about the copyright.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
- **********************************************************************}
- unit Graph;
- interface
- uses
- windows;
- {$i graphh.inc}
- var
- { this procedure allows to hook keyboard messages }
- charmessagehandler : function(Window: hwnd; AMessage, WParam,
- LParam: Longint): Longint;
- { this procedure allows to hook mouse messages }
- mousemessagehandler : function(Window: hwnd; AMessage, WParam,
- LParam: Longint): Longint;
- { this procedure allows to wm_command messages }
- commandmessagehandler : function(Window: hwnd; AMessage, WParam,
- LParam: Longint): Longint;
- NotifyMessageHandler : function(Window: hwnd; AMessage, WParam,
- LParam: Longint): Longint;
- OnGraphWindowCreation : procedure;
- GraphWindow,ParentWindow : HWnd;
- // this allows direct drawing to the window
- bitmapdc : hdc;
- windc : hdc;
- const
- { predefined window style }
- { we shouldn't set CS_DBLCLKS here }
- { because most dos applications }
- { handle double clicks on it's own }
- graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw;
- windowtitle : pchar = 'Graph window application';
- menu : hmenu = 0;
- icon : hicon = 0;
- drawtoscreen : boolean = true;
- drawtobitmap : boolean = true;
- // the graph window can be a child window, this allows to add toolbars
- // to the main window
- UseChildWindow : boolean = false;
- // this allows to specify an offset for the child child window
- ChildOffset : rect = (left:0;top:0;right:0;bottom:0);
- CONST
- m640x200x16 = VGALo;
- m640x400x16 = VGAMed;
- m640x480x16 = VGAHi;
- { VESA Specific video modes. }
- m320x200x32k = $10D;
- m320x200x64k = $10E;
- m640x400x256 = $100;
- m640x480x256 = $101;
- m640x480x32k = $110;
- m640x480x64k = $111;
- m800x600x16 = $102;
- m800x600x256 = $103;
- m800x600x32k = $113;
- m800x600x64k = $114;
- m1024x768x16 = $104;
- m1024x768x256 = $105;
- m1024x768x32k = $116;
- m1024x768x64k = $117;
- m1280x1024x16 = $106;
- m1280x1024x256 = $107;
- m1280x1024x32k = $119;
- m1280x1024x64k = $11A;
- { some extra modes which applies only to GUI }
- mLargestWindow16 = $f0;
- mLargestWindow256 = $f1;
- mLargestWindow32k = $f2;
- mLargestWindow64k = $f3;
- mLargestWindow16M = $f4;
- mMaximizedWindow16 = $f5;
- mMaximizedWindow256 = $f6;
- mMaximizedWindow32k = $f7;
- mMaximizedWindow64k = $f8;
- mMaximizedWindow16M = $f9;
- implementation
- uses
- strings;
- {
- Remarks:
- Colors in 16 color mode:
- ------------------------
- - the behavior of xor/or/and put isn't 100%:
- it is done using the RGB color getting from windows
- instead of the palette index!
- - palette operations aren't supported
- To solve these drawbacks, setpalette must be implemented
- by exchanging the colors in the DCs, further GetPaletteEntry
- must be used when doing xor/or/and operations
- }
- const
- InternalDriverName = 'WIN32GUI';
- {$i graph.inc}
- { used to create a file containing all calls to WM_PAINT
- WARNING this probably creates HUGE files PM }
- { $define DEBUG_WM_PAINT}
- var
- savedscreen : hbitmap;
- graphrunning : boolean;
- graphdrawing : tcriticalsection;
- pens : array[0..15] of HPEN;
- {$ifdef DEBUG_WM_PAINT}
- graphdebug : text;
- const
- wm_paint_count : longint = 0;
- var
- {$endif DEBUG_WM_PAINT}
- oldbitmap : hgdiobj;
- pal : ^rgbrec;
- // SavePtr : pointer; { we don't use that pointer }
- MessageThreadHandle : Handle;
- MessageThreadID : DWord;
- function GetPaletteEntry(r,g,b : word) : word;
- var
- dist,i,index,currentdist : longint;
- begin
- dist:=$7fffffff;
- index:=0;
- for i:=0 to maxcolors do
- begin
- currentdist:=abs(r-pal[i].red)+abs(g-pal[i].green)+
- abs(b-pal[i].blue);
- if currentdist<dist then
- begin
- index:=i;
- dist:=currentdist;
- if dist=0 then
- break;
- end;
- end;
- GetPaletteEntry:=index;
- end;
- procedure PutPixel16Win32GUI(x,y : integer;pixel : word);
- var
- c : colorref;
- begin
- x:=x+startxviewport;
- y:=y+startyviewport;
- { convert to absolute coordinates and then verify clipping...}
- if clippixels then
- begin
- if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
- (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
- exit;
- end;
- if graphrunning then
- begin
- c:=RGB(pal[pixel].red,pal[pixel].green,pal[pixel].blue);
- EnterCriticalSection(graphdrawing);
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- LeaveCriticalSection(graphdrawing);
- end;
- end;
- function GetPixel16Win32GUI(x,y : integer) : word;
- var
- c : COLORREF;
- begin
- x:=x+startxviewport;
- y:=y+startyviewport;
- { convert to absolute coordinates and then verify clipping...}
- if clippixels then
- begin
- if (x<startxviewport) or (x>(startxviewport+viewwidth)) or
- (y<StartyViewPort) or (y>(startyviewport+viewheight)) then
- exit;
- end;
- if graphrunning then
- begin
- EnterCriticalSection(graphdrawing);
- c:=Windows.GetPixel(bitmapdc,x,y);
- LeaveCriticalSection(graphdrawing);
- GetPixel16Win32GUI:=GetPaletteEntry(GetRValue(c),GetGValue(c),GetBValue(c));
- end
- else
- begin
- _graphresult:=grerror;
- exit;
- end;
- end;
- procedure DirectPutPixel16Win32GUI(x,y : integer);
- var
- col : longint;
- c,c2 : COLORREF;
- begin
- if graphrunning then
- begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- case currentwritemode of
- XorPut:
- Begin
- c2:=Windows.GetPixel(windc,x,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End;
- AndPut:
- Begin
- c2:=Windows.GetPixel(windc,x,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End;
- OrPut:
- Begin
- c2:=Windows.GetPixel(windc,x,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End
- else
- Begin
- If CurrentWriteMode<>NotPut Then
- col:=CurrentColor
- Else col := Not(CurrentColor);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- End
- end;
- LeaveCriticalSection(graphdrawing);
- end;
- end;
- var
- bitmapfontverticalcache : array[0..255] of HBITMAP;
- bitmapfonthorizoncache : array[0..255] of HBITMAP;
- procedure OutTextXYWin32GUI(x,y : smallint;const TextString : string);
- type
- Tpoint = record
- X,Y: smallint;
- end;
- var
- i,j,k,c : longint;
- xpos,ypos : longint;
- counter : longint;
- cnt1,cnt2 : smallint;
- cnt3,cnt4 : smallint;
- charsize : word;
- WriteMode : word;
- curX2, curY2, xpos2, ypos2, x2, y2: graph_float;
- oldvalues : linesettingstype;
- fontbitmap : TBitmapChar;
- chr : char;
- curx2i,cury2i,
- xpos2i,ypos2i : longint;
- charbitmap,oldcharbitmap : HBITMAP;
- chardc : HDC;
- color : longint;
- brushwin,oldbrushwin,brushbitmap,oldbrushbitmap : HBRUSH;
- bitmaprgn,winrgn : HRGN;
- begin
- { save current write mode }
- WriteMode := CurrentWriteMode;
- CurrentWriteMode := NormalPut;
- GetTextPosition(xpos,ypos,textstring);
- X:=X-XPos; Y:=Y+YPos;
- XPos:=X; YPos:=Y;
- CharSize := CurrentTextInfo.Charsize;
- if Currenttextinfo.font=DefaultFont then
- begin
- if CurrentTextInfo.direction=HorizDir then
- { Horizontal direction }
- begin
- if (x>viewwidth) or (y>viewheight) or
- (x<0) or (y<0) then
- begin
- CurrentWriteMode:=WriteMode;
- exit;
- end;
- EnterCriticalSection(graphdrawing);
- c:=length(textstring);
- chardc:=CreateCompatibleDC(windc);
- if currentcolor<>white then
- begin
- color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
- pal[currentcolor].blue);
- if drawtoscreen then
- begin
- brushwin:=CreateSolidBrush(color);
- oldbrushwin:=SelectObject(windc,brushwin);
- end;
- if drawtobitmap then
- begin
- brushbitmap:=CreateSolidBrush(color);
- oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
- end;
- end;
- inc(x,startxviewport);
- inc(y,startyviewport);
- { let windows do the clipping }
- if drawtobitmap then
- begin
- bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(bitmapdc,bitmaprgn);
- end;
- if drawtoscreen then
- begin
- winrgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(windc,winrgn);
- end;
- for i:=0 to c-1 do
- begin
- xpos:=x+(i*8)*Charsize;
- if bitmapfonthorizoncache[byte(textstring[i+1])]=0 then
- begin
- charbitmap:=CreateCompatibleBitmap(windc,8,8);
- if charbitmap=0 then
- writeln('Bitmap konnte nicht erzeugt werden!');
- oldcharbitmap:=SelectObject(chardc,charbitmap);
- Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
- for j:=0 to 7 do
- for k:=0 to 7 do
- if Fontbitmap[j,k]<>0 then
- SetPixelV(chardc,k,j,$ffffff)
- else
- SetPixelV(chardc,k,j,0);
- bitmapfonthorizoncache[byte(textstring[i+1])]:=charbitmap;
- SelectObject(chardc,oldcharbitmap);
- end;
- oldcharbitmap:=SelectObject(chardc,bitmapfonthorizoncache[byte(textstring[i+1])]);
- if CharSize=1 then
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- BitBlt(windc,xpos,y,8,8,chardc,0,0,SRCPAINT);
- if drawtobitmap then
- BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- BitBlt(windc,xpos,y,8,8,chardc,0,0,$00220326);
- // ROP $00EA02E9 = DPSao
- BitBlt(windc,xpos,y,8,8,chardc,0,0,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00220326);
- BitBlt(bitmapdc,xpos,y,8,8,chardc,0,0,$00EA02E9);
- end;
- end;
- end
- else
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- if drawtobitmap then
- StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- // ROP $00EA02E9 = DPSao
- StretchBlt(windc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- StretchBlt(bitmapdc,xpos,y,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- end;
- end;
- SelectObject(chardc,oldcharbitmap);
- end;
- if currentcolor<>white then
- begin
- if drawtoscreen then
- begin
- SelectObject(windc,oldbrushwin);
- DeleteObject(brushwin);
- end;
- if drawtobitmap then
- begin
- SelectObject(bitmapdc,oldbrushbitmap);
- DeleteObject(brushbitmap);
- end;
- end;
- { release clip regions }
- if drawtobitmap then
- begin
- SelectClipRgn(bitmapdc,0);
- DeleteObject(bitmaprgn);
- end;
- if drawtoscreen then
- begin
- SelectClipRgn(windc,0);
- DeleteObject(winrgn);
- end;
- DeleteDC(chardc);
- LeaveCriticalSection(graphdrawing);
- end
- else
- { Vertical direction }
- begin
- if (x>viewwidth) or (y>viewheight) or
- (x<0) or (y<0) then
- begin
- CurrentWriteMode:=WriteMode;
- exit;
- end;
- EnterCriticalSection(graphdrawing);
- c:=length(textstring);
- chardc:=CreateCompatibleDC(windc);
- if currentcolor<>white then
- begin
- color:=RGB(pal[currentcolor].red,pal[currentcolor].green,
- pal[currentcolor].blue);
- if drawtoscreen then
- begin
- brushwin:=CreateSolidBrush(color);
- oldbrushwin:=SelectObject(windc,brushwin);
- end;
- if drawtobitmap then
- begin
- brushbitmap:=CreateSolidBrush(color);
- oldbrushbitmap:=SelectObject(bitmapdc,brushbitmap);
- end;
- end;
- inc(x,startxviewport);
- inc(y,startyviewport);
- { let windows do the clipping }
- if drawtoscreen then
- begin
- winrgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(windc,winrgn);
- end;
- if drawtobitmap then
- begin
- bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(bitmapdc,bitmaprgn);
- end;
- for i:=0 to c-1 do
- begin
- ypos:=y+1-((i+1)*8)*CharSize;
- if bitmapfontverticalcache[byte(textstring[i+1])]=0 then
- begin
- charbitmap:=CreateCompatibleBitmap(windc,8,8);
- if charbitmap=0 then
- writeln('Bitmap konnte nicht erzeugt werden!');
- oldcharbitmap:=SelectObject(chardc,charbitmap);
- Fontbitmap:=TBitmapChar(DefaultFontData[textstring[i+1]]);
- for j:=0 to 7 do
- for k:=0 to 7 do
- if Fontbitmap[j,k]<>0 then
- SetPixelV(chardc,j,7-k,$ffffff)
- else
- SetPixelV(chardc,j,7-k,0);
- bitmapfontverticalcache[byte(textstring[i+1])]:=charbitmap;
- SelectObject(chardc,oldcharbitmap);
- end;
- oldcharbitmap:=SelectObject(chardc,bitmapfontverticalcache[byte(textstring[i+1])]);
- if CharSize=1 then
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- BitBlt(windc,x,ypos,8,8,chardc,0,0,SRCPAINT);
- if drawtobitmap then
- BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- BitBlt(windc,x,ypos,8,8,chardc,0,0,$00220326);
- // ROP $00EA02E9 = DPSao
- BitBlt(windc,x,ypos,8,8,chardc,0,0,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00220326);
- BitBlt(bitmapdc,x,ypos,8,8,chardc,0,0,$00EA02E9);
- end;
- end;
- end
- else
- begin
- if currentcolor=white then
- begin
- if drawtoscreen then
- StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- if drawtobitmap then
- StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,SRCPAINT);
- end
- else
- begin
- { could we do this with one pattern operation ?? }
- { we would need something like DSnaSPao }
- if drawtoscreen then
- begin
- // ROP $00220326=DSna
- StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- // ROP $00EA02E9 = DPSao
- StretchBlt(windc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- if drawtobitmap then
- begin
- StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00220326);
- StretchBlt(bitmapdc,x,ypos,8*charsize,8*charsize,chardc,0,0,8,8,$00EA02E9);
- end;
- end;
- end;
- SelectObject(chardc,oldcharbitmap);
- end;
- if currentcolor<>white then
- begin
- if drawtoscreen then
- begin
- SelectObject(windc,oldbrushwin);
- DeleteObject(brushwin);
- end;
- if drawtobitmap then
- begin
- SelectObject(bitmapdc,oldbrushbitmap);
- DeleteObject(brushbitmap);
- end;
- end;
- { release clip regions }
- if drawtoscreen then
- begin
- SelectClipRgn(windc,0);
- DeleteObject(winrgn);
- end;
- if drawtobitmap then
- begin
- SelectClipRgn(bitmapdc,0);
- DeleteObject(bitmaprgn);
- end;
- DeleteDC(chardc);
- LeaveCriticalSection(graphdrawing);
- end;
- end else
- { This is a stroked font which is already loaded into memory }
- begin
- getlinesettings(oldvalues);
- { reset line style to defaults }
- setlinestyle(solidln,oldvalues.pattern,normwidth);
- if Currenttextinfo.direction=vertdir then
- xpos:=xpos + Textheight(textstring);
- CurX2:=xpos; xpos2 := curX2; x2 := xpos2;
- CurY2:=ypos; ypos2 := curY2; y2 := ypos2;
- { x:=xpos; y:=ypos;}
- for i:=1 to length(textstring) do
- begin
- c:=byte(textstring[i]);
- { Stroke_Count[c] := }
- unpack( fonts[CurrentTextInfo.font].instr,
- fonts[CurrentTextInfo.font].Offsets[c], Strokes );
- counter:=0;
- while true do
- begin
- if CurrentTextInfo.direction=VertDir then
- begin
- xpos2:=x2-(Strokes[counter].Y*CurrentYRatio);
- ypos2:=y2-(Strokes[counter].X*CurrentXRatio);
- end
- else
- begin
- xpos2:=x2+(Strokes[counter].X*CurrentXRatio) ;
- ypos2:=y2-(Strokes[counter].Y*CurrentYRatio) ;
- end;
- case opcodes(Strokes[counter].opcode) of
- _END_OF_CHAR: break;
- _DO_SCAN: begin
- { Currently unsupported };
- end;
- _MOVE : Begin
- CurX2 := XPos2;
- CurY2 := YPos2;
- end;
- _DRAW: Begin
- curx2i:=trunc(CurX2);
- cury2i:=trunc(CurY2);
- xpos2i:=trunc(xpos2);
- ypos2i:=trunc(ypos2);
- { this optimization doesn't matter that much
- if (curx2i=xpos2i) then
- begin
- if (cury2i=ypos2i) then
- putpixel(curx2i,cury2i,currentcolor)
- else if (cury2i+1=ypos2i) or
- (cury2i=ypos2i+1) then
- begin
- putpixel(curx2i,cury2i,currentcolor);
- putpixel(curx2i,ypos2i,currentcolor);
- end
- else
- Line(curx2i,cury2i,xpos2i,ypos2i);
- end
- else if (cury2i=ypos2i) then
- begin
- if (curx2i+1=xpos2i) or
- (curx2i=xpos2i+1) then
- begin
- putpixel(curx2i,cury2i,currentcolor);
- putpixel(xpos2i,cury2i,currentcolor);
- end
- else
- Line(curx2i,cury2i,xpos2i,ypos2i);
- end
- else
- }
- Line(curx2i,cury2i,xpos2i,ypos2i);
- CurX2:=xpos2;
- CurY2:=ypos2;
- end;
- else
- Begin
- end;
- end;
- Inc(counter);
- end; { end while }
- if Currenttextinfo.direction=VertDir then
- y2:=y2-(byte(fonts[CurrenttextInfo.font].widths[c])*CurrentXRatio)
- else
- x2:=x2+(byte(fonts[Currenttextinfo.font].widths[c])*CurrentXRatio);
- end;
- setlinestyle( oldvalues.linestyle, oldvalues.pattern, oldvalues.thickness);
- end;
- { restore write mode }
- CurrentWriteMode := WriteMode;
- end;
- procedure HLine16Win32GUI(x,x2,y: integer);
- var
- c,c2 : COLORREF;
- col,i : longint;
- oldpen,pen : HPEN;
- Begin
- if graphrunning then
- begin
- { must we swap the values? }
- if x>x2 then
- Begin
- x:=x xor x2;
- x2:=x xor x2;
- x:=x xor x2;
- end;
- if ClipPixels then
- begin
- if (x>ViewWidth) or (y<0) or (y>ViewHeight) or (x2<0) then
- exit;
- if x<0 then
- x:=0;
- if x2>ViewWidth then
- x2:=ViewWidth;
- end;
- X:=X+StartXViewPort;
- X2:=X2+StartXViewPort;
- Y:=Y+StartYViewPort;
- Case CurrentWriteMode of
- AndPut:
- Begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- for i:=x to x2 do
- begin
- c2:=Windows.GetPixel(windc,i,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) and c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,i,y,c);
- if drawtoscreen then
- SetPixelV(windc,i,y,c);
- end;
- LeaveCriticalSection(graphdrawing);
- End;
- XorPut:
- Begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- for i:=x to x2 do
- begin
- c2:=Windows.GetPixel(windc,i,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) xor c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,i,y,c);
- if drawtoscreen then
- SetPixelV(windc,i,y,c);
- end;
- LeaveCriticalSection(graphdrawing);
- End;
- OrPut:
- Begin
- EnterCriticalSection(graphdrawing);
- col:=CurrentColor;
- for i:=x to x2 do
- begin
- c2:=Windows.GetPixel(windc,i,y);
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue) or c2;
- if drawtobitmap then
- SetPixelV(bitmapdc,i,y,c);
- if drawtoscreen then
- SetPixelV(windc,i,y,c);
- end;
- LeaveCriticalSection(graphdrawing);
- End
- Else
- Begin
- If CurrentWriteMode<>NotPut Then
- col:=CurrentColor
- Else col:=Not(CurrentColor);
- EnterCriticalSection(graphdrawing);
- if x2-x<=2 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- for x := x to x2 do
- begin
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- end;
- end
- else
- begin
- if (col>=0) and (col<=high(pens)) then
- begin
- if pens[col]=0 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pens[col]:=CreatePen(PS_SOLID,1,c);
- end;
- pen:=pens[col];
- end
- else
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pen:=CreatePen(PS_SOLID,1,c);
- end;
- if drawtobitmap then
- begin
- oldpen:=SelectObject(bitmapdc,pen);
- Windows.MoveToEx(bitmapdc,x,y,nil);
- Windows.LineTo(bitmapdc,x2+1,y);
- SelectObject(bitmapdc,oldpen);
- end;
- if drawtoscreen then
- begin
- oldpen:=SelectObject(windc,pen);
- Windows.MoveToEx(windc,x,y,nil);
- Windows.LineTo(windc,x2+1,y);
- SelectObject(windc,oldpen);
- end;
- if (col<0) or (col>high(pens)) then
- DeleteObject(pen);
- end;
- LeaveCriticalSection(graphdrawing);
- End;
- End;
- end;
- end;
- procedure VLine16Win32GUI(x,y,y2: smallint); {$ifndef fpc}far;{$endif fpc}
- var
- ytmp: smallint;
- col,c : longint;
- oldpen,pen : HPEN;
- Begin
- { must we swap the values? }
- if y >= y2 then
- Begin
- ytmp := y2;
- y2 := y;
- y:= ytmp;
- end;
- if ClipPixels then
- begin
- if (x>ViewWidth) or (x<0) or (y>ViewHeight) or (y2<0) then
- exit;
- if y<0 then
- y:=0;
- if y2>ViewHeight then
- y2:=ViewHeight;
- end;
- { First convert to global coordinates }
- X := X + StartXViewPort;
- Y2 := Y2 + StartYViewPort;
- Y := Y + StartYViewPort;
- if currentwritemode=normalput then
- begin
- col:=CurrentColor;
- EnterCriticalSection(graphdrawing);
- if y2-y<=2 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- for y := y to y2 do
- begin
- if drawtobitmap then
- SetPixelV(bitmapdc,x,y,c);
- if drawtoscreen then
- SetPixelV(windc,x,y,c);
- end;
- end
- else
- begin
- if (col>=0) and (col<=high(pens)) then
- begin
- if pens[col]=0 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pens[col]:=CreatePen(PS_SOLID,1,c);
- end;
- pen:=pens[col];
- end
- else
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pen:=CreatePen(PS_SOLID,1,c);
- end;
- if drawtobitmap then
- begin
- oldpen:=SelectObject(bitmapdc,pen);
- Windows.MoveToEx(bitmapdc,x,y,nil);
- Windows.LineTo(bitmapdc,x,y2+1);
- SelectObject(bitmapdc,oldpen);
- end;
- if drawtoscreen then
- begin
- oldpen:=SelectObject(windc,pen);
- Windows.MoveToEx(windc,x,y,nil);
- Windows.LineTo(windc,x,y2+1);
- SelectObject(windc,oldpen);
- end;
- if (col<0) or (col>high(pens)) then
- DeleteObject(pen);
- end;
- LeaveCriticalSection(graphdrawing);
- end
- else
- for y := y to y2 do Directputpixel(x,y)
- End;
- procedure Circle16Win32GUI(X, Y: smallint; Radius:Word);
- var
- bitmaprgn,winrgn : HRGN;
- col,c : longint;
- oldpen,pen : HPEN;
- OriginalArcInfo: ArcCoordsType;
- OldWriteMode: word;
- begin
- if (Radius = 0) then
- Exit;
- if (Radius = 1) then
- begin
- { only normal put mode is supported by a call to PutPixel }
- PutPixel(X, Y, CurrentColor);
- Exit;
- end;
- if (Radius = 2) then
- begin
- { only normal put mode is supported by a call to PutPixel }
- PutPixel(X-1, Y, CurrentColor);
- PutPixel(X+1, Y, CurrentColor);
- PutPixel(X, Y-1, CurrentColor);
- PutPixel(X, Y+1, CurrentColor);
- Exit;
- end;
- if LineInfo.Thickness = Normwidth then
- begin
- EnterCriticalSection(graphdrawing);
- { let windows do the clipping }
- if drawtobitmap then
- begin
- bitmaprgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(bitmapdc,bitmaprgn);
- end;
- if drawtoscreen then
- begin
- winrgn:=CreateRectRgn(startxviewport,startyviewport,
- startxviewport+viewwidth+1,startyviewport+viewheight+1);
- SelectClipRgn(windc,winrgn);
- end;
- inc(x,StartXViewPort);
- inc(y,StartYViewPort);
- col:=CurrentColor;
- if (col>=0) and (col<=high(pens)) then
- begin
- if pens[col]=0 then
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pens[col]:=CreatePen(PS_SOLID,1,c);
- end;
- pen:=pens[col];
- end
- else
- begin
- c:=RGB(pal[col].red,pal[col].green,pal[col].blue);
- pen:=CreatePen(PS_SOLID,1,c);
- end;
- if drawtobitmap then
- begin
- oldpen:=SelectObject(bitmapdc,pen);
- windows.arc(bitmapdc,x-radius,y-radius,x+radius,y+radius,
- x,y-radius,x,y-radius);
- SelectObject(bitmapdc,oldpen);
- end;
- if drawtoscreen then
- begin
- oldpen:=SelectObject(windc,pen);
- windows.arc(windc,x-radius,y-radius,x+radius,y+radius,
- x,y-radius,x,y-radius);
- SelectObject(windc,oldpen);
- end;
- if (col<0) or (col>high(pens)) then
- DeleteObject(pen);
- { release clip regions }
- if drawtoscreen then
- begin
- SelectClipRgn(windc,0);
- DeleteObject(winrgn);
- end;
- if drawtobitmap then
- begin
- SelectClipRgn(bitmapdc,0);
- DeleteObject(bitmaprgn);
- end;
- LeaveCriticalSection(graphdrawing);
- end
- else
- begin
- { save state of arc information }
- { because it is not needed for }
- { a circle call. }
- move(ArcCall,OriginalArcInfo, sizeof(ArcCall));
- InternalEllipse(X,Y,Radius,Radius,0,360,{$ifdef fpc}@{$endif}DummyPatternLine);
- { restore arc information }
- move(OriginalArcInfo, ArcCall,sizeof(ArcCall));
- end;
- end;
- {
- Procedure PutImageWin32GUI(X,Y: smallint; var Bitmap; BitBlt: Word); {$ifndef fpc}far;{$endif fpc}
- type
- pt = array[0..$fffffff] of word;
- ptw = array[0..2] of longint;
- var
- k: longint;
- oldCurrentColor: word;
- oldCurrentWriteMode, i, j, y1, x1, deltaX, deltaX1, deltaY: smallint;
- Begin
- {$ifdef logging}
- LogLn('putImage at ('+strf(x)+','+strf(y)+') with width '+strf(ptw(Bitmap)[0])+
- ' and height '+strf(ptw(Bitmap)[1]));
- deltaY := 0;
- {$endif logging}
- inc(x,startXViewPort);
- inc(y,startYViewPort);
- x1 := ptw(Bitmap)[0]+x; { get width and adjust end coordinate accordingly }
- y1 := ptw(Bitmap)[1]+y; { get height and adjust end coordinate accordingly }
- deltaX := 0;
- deltaX1 := 0;
- k := 3 * sizeOf(Longint) div sizeOf(Word); { Three reserved longs at start of bitmap }
- { check which part of the image is in the viewport }
- if clipPixels then
- begin
- if y < startYViewPort then
- begin
- deltaY := startYViewPort - y;
- inc(k,(x1-x+1)*deltaY);
- y := startYViewPort;
- end;
- if y1 > startYViewPort+viewHeight then
- y1 := startYViewPort+viewHeight;
- if x < startXViewPort then
- begin
- deltaX := startXViewPort-x;
- x := startXViewPort;
- end;
- if x1 > startXViewPort + viewWidth then
- begin
- deltaX1 := x1 - (startXViewPort + viewWidth);
- x1 := startXViewPort + viewWidth;
- end;
- end;
- {$ifdef logging}
- LogLn('deltax: '+strf(deltax)+', deltax1: '+strf(deltax1)+',deltay: '+strf(deltay));
- {$endif logging}
- case bitBlt of
- end;
- oldCurrentColor := currentColor;
- oldCurrentWriteMode := currentWriteMode;
- currentWriteMode := bitBlt;
- for j:=Y to Y1 do
- Begin
- inc(k,deltaX);
- for i:=X to X1 do
- begin
- currentColor := pt(bitmap)[k];
- directPutPixel(i,j);
- inc(k);
- end;
- inc(k,deltaX1);
- end;
- currentWriteMode := oldCurrentWriteMode;
- currentColor := oldCurrentColor;
- end;
- }
- procedure SetRGBPaletteWin32GUI(colorNum,redValue,greenvalue,
- bluevalue : integer);
- begin
- if directcolor or (colornum<0) or (colornum>=maxcolor) then
- begin
- _graphresult:=grerror;
- exit;
- end;
- pal[colorNum].red:=redValue;
- pal[colorNum].green:=greenValue;
- pal[colorNum].blue:=blueValue;
- end;
- procedure GetRGBPaletteWin32GUI(colorNum : integer;
- var redValue,greenvalue,bluevalue : integer);
- begin
- if directcolor or (colornum<0) or (colornum>=maxcolor) then
- begin
- _graphresult:=grerror;
- exit;
- end;
- redValue:=pal[colorNum].red;
- greenValue:=pal[colorNum].green;
- blueValue:=pal[colorNum].blue;
- end;
- procedure savestate;
- begin
- end;
- procedure restorestate;
- begin
- end;
- function WindowProcGraph(Window: HWnd; AMessage, WParam,
- LParam: Longint): Longint; stdcall; export;
- var
- dc : hdc;
- ps : paintstruct;
- r : rect;
- oldbrush : hbrush;
- oldpen : hpen;
- i : longint;
- begin
- WindowProcGraph := 0;
- case AMessage of
- wm_lbuttondown,
- wm_rbuttondown,
- wm_mbuttondown,
- wm_lbuttonup,
- wm_rbuttonup,
- wm_mbuttonup,
- wm_lbuttondblclk,
- wm_rbuttondblclk,
- wm_mbuttondblclk:
- {
- This leads to problem, i.e. the menu etc doesn't work any longer
- wm_nclbuttondown,
- wm_ncrbuttondown,
- wm_ncmbuttondown,
- wm_nclbuttonup,
- wm_ncrbuttonup,
- wm_ncmbuttonup,
- wm_nclbuttondblclk,
- wm_ncrbuttondblclk,
- wm_ncmbuttondblclk:
- }
- begin
- if assigned(mousemessagehandler) then
- WindowProcGraph:=mousemessagehandler(window,amessage,wparam,lparam);
- end;
- wm_notify:
- begin
- if assigned(notifymessagehandler) then
- WindowProcGraph:=notifymessagehandler(window,amessage,wparam,lparam);
- end;
- wm_command:
- if assigned(commandmessagehandler) then
- WindowProcGraph:=commandmessagehandler(window,amessage,wparam,lparam);
- wm_keydown,
- wm_keyup,
- wm_char:
- begin
- if assigned(charmessagehandler) then
- WindowProcGraph:=charmessagehandler(window,amessage,wparam,lparam);
- end;
- wm_paint:
- begin
- {$ifdef DEBUG_WM_PAINT}
- inc(wm_paint_count);
- {$endif DEBUG_WM_PAINT}
- {$ifdef DEBUGCHILDS}
- writeln('Start child painting');
- {$endif DEBUGCHILDS}
- if not GetUpdateRect(Window,@r,false) then
- exit;
- EnterCriticalSection(graphdrawing);
- graphrunning:=true;
- dc:=BeginPaint(Window,@ps);
- {$ifdef DEBUG_WM_PAINT}
- Writeln(graphdebug,'WM_PAINT in ((',r.left,',',r.top,
- '),(',r.right,',',r.bottom,'))');
- {$endif def DEBUG_WM_PAINT}
- if graphrunning then
- {BitBlt(dc,0,0,maxx+1,maxy+1,bitmapdc,0,0,SRCCOPY);}
- BitBlt(dc,r.left,r.top,r.right-r.left+1,r.bottom-r.top+1,bitmapdc,r.left,r.top,SRCCOPY);
- EndPaint(Window,ps);
- LeaveCriticalSection(graphdrawing);
- Exit;
- end;
- wm_create:
- begin
- {$ifdef DEBUG_WM_PAINT}
- assign(graphdebug,'wingraph.log');
- rewrite(graphdebug);
- {$endif DEBUG_WM_PAINT}
- {$ifdef DEBUGCHILDS}
- writeln('Creating window (HWND: ',window,')... ');
- {$endif DEBUGCHILDS}
- GraphWindow:=window;
- EnterCriticalSection(graphdrawing);
- dc:=GetDC(window);
- {$ifdef DEBUGCHILDS}
- writeln('Window DC: ',dc);
- {$endif DEBUGCHILDS}
- bitmapdc:=CreateCompatibleDC(dc);
- savedscreen:=CreateCompatibleBitmap(dc,maxx+1,maxy+1);
- ReleaseDC(window,dc);
- oldbitmap:=SelectObject(bitmapdc,savedscreen);
- windc:=GetDC(window);
- // clear everything
- oldpen:=SelectObject(bitmapdc,GetStockObject(BLACK_PEN));
- oldbrush:=SelectObject(bitmapdc,GetStockObject(BLACK_BRUSH));
- Windows.Rectangle(bitmapdc,0,0,maxx,maxy);
- SelectObject(bitmapdc,oldpen);
- SelectObject(bitmapdc,oldbrush);
- // ... the window too
- oldpen:=SelectObject(windc,GetStockObject(BLACK_PEN));
- oldbrush:=SelectObject(windc,GetStockObject(BLACK_BRUSH));
- Windows.Rectangle(windc,0,0,maxx,maxy);
- SelectObject(windc,oldpen);
- SelectObject(windc,oldbrush);
- // clear font cache
- fillchar(bitmapfonthorizoncache,sizeof(bitmapfonthorizoncache),0);
- fillchar(bitmapfontverticalcache,sizeof(bitmapfontverticalcache),0);
- // clear predefined pens
- fillchar(pens,sizeof(pens),0);
- if assigned(OnGraphWindowCreation) then
- OnGraphWindowCreation;
- LeaveCriticalSection(graphdrawing);
- {$ifdef DEBUGCHILDS}
- writeln('done');
- GetClientRect(window,@r);
- writeln('Window size: ',r.right,',',r.bottom);
- {$endif DEBUGCHILDS}
- end;
- wm_Destroy:
- begin
- EnterCriticalSection(graphdrawing);
- graphrunning:=false;
- ReleaseDC(GraphWindow,windc);
- SelectObject(bitmapdc,oldbitmap);
- DeleteObject(savedscreen);
- DeleteDC(bitmapdc);
- // release font cache
- for i:=0 to 255 do
- if bitmapfonthorizoncache[i]<>0 then
- DeleteObject(bitmapfonthorizoncache[i]);
- for i:=0 to 255 do
- if bitmapfontverticalcache[i]<>0 then
- DeleteObject(bitmapfontverticalcache[i]);
- for i:=0 to high(pens) do
- if pens[i]<>0 then
- DeleteObject(pens[i]);
- LeaveCriticalSection(graphdrawing);
- {$ifdef DEBUG_WM_PAINT}
- close(graphdebug);
- {$endif DEBUG_WM_PAINT}
- PostQuitMessage(0);
- Exit;
- end
- else
- WindowProcGraph := DefWindowProc(Window, AMessage, WParam, LParam);
- end;
- end;
- function WindowProcParent(Window: HWnd; AMessage, WParam,
- LParam: Longint): Longint; stdcall; export;
- begin
- WindowProcParent := 0;
- case AMessage of
- wm_keydown,
- wm_keyup,
- wm_char:
- begin
- if assigned(charmessagehandler) then
- WindowProcParent:=charmessagehandler(window,amessage,wparam,lparam);
- end;
- wm_notify:
- begin
- if assigned(notifymessagehandler) then
- WindowProcParent:=notifymessagehandler(window,amessage,wparam,lparam);
- end;
- wm_command:
- if assigned(commandmessagehandler) then
- WindowProcParent:=commandmessagehandler(window,amessage,wparam,lparam);
- else
- WindowProcParent := DefWindowProc(Window, AMessage, WParam, LParam);
- end;
- end;
- function WinRegister: Boolean;
- var
- WindowClass: WndClass;
- begin
- WindowClass.Style := graphwindowstyle;
- WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
- WindowClass.cbClsExtra := 0;
- WindowClass.cbWndExtra := 0;
- WindowClass.hInstance := system.MainInstance;
- if icon<>0 then
- WindowClass.hIcon := icon
- else
- WindowClass.hIcon := LoadIcon(0, idi_Application);
- WindowClass.hCursor := LoadCursor(0, idc_Arrow);
- WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
- if menu<>0 then
- WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
- else
- WindowClass.lpszMenuName := nil;
- WindowClass.lpszClassName := 'FPCGraphWindow';
- winregister:=RegisterClass(WindowClass) <> 0;
- end;
- function WinRegisterWithChild: Boolean;
- var
- WindowClass: WndClass;
- begin
- WindowClass.Style := graphwindowstyle;
- WindowClass.lpfnWndProc := WndProc(@WindowProcParent);
- WindowClass.cbClsExtra := 0;
- WindowClass.cbWndExtra := 0;
- WindowClass.hInstance := system.MainInstance;
- if icon<>0 then
- WindowClass.hIcon := icon
- else
- WindowClass.hIcon := LoadIcon(0, idi_Application);
- WindowClass.hCursor := LoadCursor(0, idc_Arrow);
- WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
- if menu<>0 then
- WindowClass.lpszMenuName := MAKEINTRESOURCE(menu)
- else
- WindowClass.lpszMenuName := nil;
- WindowClass.lpszClassName := 'FPCGraphWindowMain';
- WinRegisterWithChild:=RegisterClass(WindowClass) <> 0;
- {$ifdef DEBUGCHILDS}
- writeln('Main window successfully registered: WinRegisterWithChild is ',WinRegisterWithChild);
- {$endif DEBUGCHILDS}
- if WinRegisterWithChild then
- begin
- WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
- WindowClass.lpfnWndProc := WndProc(@WindowProcGraph);
- WindowClass.cbClsExtra := 0;
- WindowClass.cbWndExtra := 0;
- WindowClass.hInstance := system.MainInstance;
- WindowClass.hIcon := 0;
- WindowClass.hCursor := LoadCursor(0, idc_Arrow);
- WindowClass.hbrBackground := GetStockObject(BLACK_BRUSH);
- WindowClass.lpszMenuName := nil;
- WindowClass.lpszClassName := 'FPCGraphWindowChild';
- WinRegisterWithChild:=RegisterClass(WindowClass)<>0;
- {$ifdef DEBUGCHILDS}
- writeln('Child window registered: WinRegisterWithChild is ',WinRegisterWithChild);
- {$endif DEBUGCHILDS}
- end;
- end;
- var
- // here we can force the creation of a maximized window }
- extrastyle : cardinal;
- { Create the Window Class }
- function WinCreate : HWnd;
- var
- hWindow: HWnd;
- begin
- WinCreate:=0;
- if UseChildWindow then
- begin
- ParentWindow:=CreateWindow('FPCGraphWindowMain', windowtitle,
- WS_OVERLAPPEDWINDOW or WS_CLIPCHILDREN or extrastyle, longint(CW_USEDEFAULT), 0,
- maxx+ChildOffset.Left+ChildOffset.Right+1+
- 2*GetSystemMetrics(SM_CXFRAME),
- maxy+ChildOffset.Top+ChildOffset.Bottom+1+
- 2*GetSystemMetrics(SM_CYFRAME)+
- GetSystemMetrics(SM_CYCAPTION),
- 0, 0, system.MainInstance, nil);
- if ParentWindow<>0 then
- begin
- ShowWindow(ParentWindow, SW_SHOW);
- UpdateWindow(ParentWindow);
- end
- else
- exit;
- hWindow:=CreateWindow('FPCGraphWindowChild',nil,
- WS_CHILD, ChildOffset.Left,ChildOffset.Top,
- maxx+1,maxy+1,
- ParentWindow, 0, system.MainInstance, nil);
- if hwindow<>0 then
- begin
- ShowWindow(hwindow, SW_SHOW);
- UpdateWindow(hwindow);
- end
- else
- exit;
- WinCreate:=hWindow;
- end
- else
- begin
- hWindow:=CreateWindow('FPCGraphWindow', windowtitle,
- ws_OverlappedWindow or extrastyle, longint(CW_USEDEFAULT), 0,
- maxx+1+2*GetSystemMetrics(SM_CXFRAME),
- maxy+1+2*GetSystemMetrics(SM_CYFRAME)+
- GetSystemMetrics(SM_CYCAPTION),
- 0, 0, system.MainInstance, nil);
- if hWindow <> 0 then
- begin
- ShowWindow(hWindow, SW_SHOW);
- UpdateWindow(hWindow);
- WinCreate:=hWindow;
- end;
- end;
- end;
- const
- winregistered : boolean = false;
- function MessageHandleThread(p : pointer) : DWord;StdCall;
- var
- AMessage: Msg;
- begin
- if not(winregistered) then
- begin
- if UseChildWindow then
- begin
- if not(WinRegisterWithChild) then
- begin
- MessageBox(0, 'Window registration failed', nil, mb_Ok);
- ExitThread(1);
- end;
- end
- else
- begin
- if not(WinRegister) then
- begin
- MessageBox(0, 'Window registration failed', nil, mb_Ok);
- ExitThread(1);
- end;
- end;
- GraphWindow:=WinCreate;
- winregistered:=true;
- end;
- if longint(GraphWindow) = 0 then begin
- MessageBox(0, 'Window creation failed', nil, mb_Ok);
- ExitThread(1);
- end;
- while longint(GetMessage(@AMessage, 0, 0, 0))=longint(true) do
- begin
- TranslateMessage(AMessage);
- DispatchMessage(AMessage);
- end;
- MessageHandleThread:=0;
- end;
- procedure InitWin32GUI16colors;
- var
- threadexitcode : longint;
- begin
- getmem(pal,sizeof(RGBrec)*maxcolor);
- move(DefaultColors,pal^,sizeof(RGBrec)*maxcolor);
- if (IntCurrentMode=mMaximizedWindow16) or
- (IntCurrentMode=mMaximizedWindow256) or
- (IntCurrentMode=mMaximizedWindow32k) or
- (IntCurrentMode=mMaximizedWindow64k) or
- (IntCurrentMode=mMaximizedWindow16M) then
- extrastyle:=ws_maximize
- else
- extrastyle:=0;
- { start graph subsystem }
- InitializeCriticalSection(graphdrawing);
- graphrunning:=false;
- MessageThreadHandle:=CreateThread(nil,0,@MessageHandleThread,
- nil,0,MessageThreadID);
- repeat
- GetExitCodeThread(MessageThreadHandle,@threadexitcode);
- until graphrunning or (threadexitcode<>STILL_ACTIVE);
- if threadexitcode<>STILL_ACTIVE then
- _graphresult := grerror;
- end;
- procedure CloseGraph;
- begin
- If not isgraphmode then
- begin
- _graphresult := grnoinitgraph;
- exit
- end;
- if UseChildWindow then
- begin
- { if the child window isn't destroyed }
- { the main window can't be closed }
- { I don't know any other way (FK) }
- PostMessage(GraphWindow,wm_destroy,0,0);
- PostMessage(ParentWindow,wm_destroy,0,0)
- end
- else
- PostMessage(GraphWindow,wm_destroy,0,0);
- PostThreadMessage(MessageThreadHandle,wm_quit,0,0);
- WaitForSingleObject(MessageThreadHandle,Infinite);
- CloseHandle(MessageThreadHandle);
- DeleteCriticalSection(graphdrawing);
- freemem(pal,sizeof(RGBrec)*maxcolor);
- end;
- procedure LineWin32GUI(X1, Y1, X2, Y2: smallint); {$ifndef fpc}far;{$endif fpc}
- var X, Y : smallint;
- deltax, deltay : smallint;
- d, dinc1, dinc2: smallint;
- xinc1 : smallint;
- xinc2 : smallint;
- yinc1 : smallint;
- yinc2 : smallint;
- i : smallint;
- Flag : Boolean; { determines pixel direction in thick lines }
- NumPixels : smallint;
- PixelCount : smallint;
- OldCurrentColor: Word;
- swtmp : smallint;
- TmpNumPixels : smallint;
- col : longint;
- pen,oldpen : hpen;
- begin
- if graphrunning then
- begin
- {******************************************}
- { SOLID LINES }
- {******************************************}
- if lineinfo.LineStyle = SolidLn then
- Begin
- { Convert to global coordinates. }
- x1 := x1 + StartXViewPort;
- x2 := x2 + StartXViewPort;
- y1 := y1 + StartYViewPort;
- y2 := y2 + StartYViewPort;
- { if fully clipped then exit... }
- if ClipPixels then
- begin
- if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
- StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
- exit;
- If LineInfo.Thickness=NormWidth then
- Begin
- EnterCriticalSection(graphdrawing);
- {
- if currentwritemode<>normalput then
- begin
- case currentwritemode of
- XORPut:
- begin
- SetROP2(windc,R2_XORPEN);
- SetROP2(bitmapdc,R2_XORPEN);
- end;
- AndPut:
- begin
- SetROP2(windc,R2_MASKPEN);
- SetROP2(bitmapdc,R2_MASKPEN);
- end;
- OrPut:
- begin
- SetROP2(windc,R2_MERGEPEN);
- SetROP2(bitmapdc,R2_MERGEPEN);
- end;
- end;
- end;
- }
- col:=RGB(pal[CurrentColor].red,pal[CurrentColor].green,pal[CurrentColor].blue);
- pen:=CreatePen(PS_SOLID,1,col);
- if pen=0 then
- writeln('Pen konnte nicht erzeugt werden!');
- oldpen:=SelectObject(windc,pen);
- MoveToEx(windc,x1,y1,nil);
- Windows.LineTo(windc,x2,y2);
- SetPixel(windc,x2,y2,col);
- SelectObject(windc,oldpen);
- oldpen:=SelectObject(bitmapdc,pen);
- MoveToEx(bitmapdc,x1,y1,nil);
- Windows.LineTo(bitmapdc,x2,y2);
- SetPixel(bitmapdc,x2,y2,col);
- SelectObject(bitmapdc,oldpen);
- DeleteObject(pen);
- {
- if currentwritemode<>normalput then
- begin
- SetROP2(windc,R2_COPYPEN);
- SetROP2(bitmapdc,R2_COPYPEN);
- end;
- }
- LeaveCriticalSection(graphdrawing);
- end
- else
- { Thick width lines }
- begin
- { Draw the pixels }
- for i := 1 to numpixels do
- begin
- { all depending on the slope, we can determine }
- { in what direction the extra width pixels will be put }
- If Flag then
- Begin
- DirectPutPixelClip(x-1,y);
- DirectPutPixelClip(x,y);
- DirectPutPixelClip(x+1,y);
- end
- else
- Begin
- DirectPutPixelClip(x, y-1);
- DirectPutPixelClip(x, y);
- DirectPutPixelClip(x, y+1);
- end;
- if d < 0 then
- begin
- d := d + dinc1;
- x := x + xinc1;
- y := y + yinc1;
- end
- else
- begin
- d := d + dinc2;
- x := x + xinc2;
- y := y + yinc2;
- end;
- end;
- end;
- end;
- end
- else
- {******************************************}
- { begin patterned lines }
- {******************************************}
- Begin
- { Convert to global coordinates. }
- x1 := x1 + StartXViewPort;
- x2 := x2 + StartXViewPort;
- y1 := y1 + StartYViewPort;
- y2 := y2 + StartYViewPort;
- { if fully clipped then exit... }
- if ClipPixels then
- begin
- if LineClipped(x1,y1,x2,y2,StartXViewPort, StartYViewPort,
- StartXViewPort+ViewWidth, StartYViewPort+ViewHeight) then
- exit;
- end;
- OldCurrentColor := CurrentColor;
- PixelCount:=0;
- if y1 = y2 then
- Begin
- { Check if we must swap }
- if x1 >= x2 then
- Begin
- swtmp := x1;
- x1 := x2;
- x2 := swtmp;
- end;
- if LineInfo.Thickness = NormWidth then
- Begin
- for PixelCount:=x1 to x2 do
- { optimization: PixelCount mod 16 }
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixel(PixelCount,y2);
- end;
- end
- else
- Begin
- for i:=-1 to 1 do
- Begin
- for PixelCount:=x1 to x2 do
- { Optimization from Thomas - mod 16 = and 15 }
- {this optimization has been performed by the compiler
- for while as well (JM)}
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixelClip(PixelCount,y2+i);
- end;
- end;
- end;
- end
- else
- if x1 = x2 then
- Begin
- { Check if we must swap }
- if y1 >= y2 then
- Begin
- swtmp := y1;
- y1 := y2;
- y2 := swtmp;
- end;
- if LineInfo.Thickness = NormWidth then
- Begin
- for PixelCount:=y1 to y2 do
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixel(x1,PixelCount);
- end;
- end
- else
- Begin
- for i:=-1 to 1 do
- Begin
- for PixelCount:=y1 to y2 do
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[PixelCount and 15] = TRUE then
- begin
- DirectPutPixelClip(x1+i,PixelCount);
- end;
- end;
- end;
- end
- else
- Begin
- oldCurrentColor := CurrentColor;
- { Calculate deltax and deltay for initialisation }
- deltax := abs(x2 - x1);
- deltay := abs(y2 - y1);
- { Initialize all vars based on which is the independent variable }
- if deltax >= deltay then
- begin
- Flag := FALSE;
- { x is independent variable }
- numpixels := deltax + 1;
- d := (2 * deltay) - deltax;
- dinc1 := deltay Shl 1;
- dinc2 := (deltay - deltax) shl 1;
- xinc1 := 1;
- xinc2 := 1;
- yinc1 := 0;
- yinc2 := 1;
- end
- else
- begin
- Flag := TRUE;
- { y is independent variable }
- numpixels := deltay + 1;
- d := (2 * deltax) - deltay;
- dinc1 := deltax Shl 1;
- dinc2 := (deltax - deltay) shl 1;
- xinc1 := 0;
- xinc2 := 1;
- yinc1 := 1;
- yinc2 := 1;
- end;
- { Make sure x and y move in the right directions }
- if x1 > x2 then
- begin
- xinc1 := - xinc1;
- xinc2 := - xinc2;
- end;
- if y1 > y2 then
- begin
- yinc1 := - yinc1;
- yinc2 := - yinc2;
- end;
- { Start drawing at <x1, y1> }
- x := x1;
- y := y1;
- If LineInfo.Thickness=ThickWidth then
- Begin
- TmpNumPixels := NumPixels-1;
- { Draw the pixels }
- for i := 0 to TmpNumPixels do
- begin
- { all depending on the slope, we can determine }
- { in what direction the extra width pixels will be put }
- If Flag then
- Begin
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[i and 15] = TRUE then
- begin
- DirectPutPixelClip(x-1,y);
- DirectPutPixelClip(x,y);
- DirectPutPixelClip(x+1,y);
- end;
- end
- else
- Begin
- { compare if we should plot a pixel here , compare }
- { with predefined line patterns... }
- if LinePatterns[i and 15] = TRUE then
- begin
- DirectPutPixelClip(x,y-1);
- DirectPutPixelClip(x,y);
- DirectPutPixelClip(x,y+1);
- end;
- end;
- if d < 0 then
- begin
- d := d + dinc1;
- x := x + xinc1;
- y := y + yinc1;
- end
- else
- begin
- d := d + dinc2;
- x := x + xinc2;
- y := y + yinc2;
- end;
- end;
- end
- else
- Begin
- { instead of putting in loop , substract by one now }
- TmpNumPixels := NumPixels-1;
- { NormWidth }
- for i := 0 to TmpNumPixels do
- begin
- if LinePatterns[i and 15] = TRUE then
- begin
- DirectPutPixel(x,y);
- end;
- if d < 0 then
- begin
- d := d + dinc1;
- x := x + xinc1;
- y := y + yinc1;
- end
- else
- begin
- d := d + dinc2;
- x := x + xinc2;
- y := y + yinc2;
- end;
- end;
- end
- end;
- {******************************************}
- { end patterned lines }
- {******************************************}
- { restore color }
- CurrentColor:=OldCurrentColor;
- end;
- end;
- end; { Line }
- { multipage support could be done by using more than one background bitmap }
- procedure SetVisualWin32GUI(page: word);
- begin
- end;
- procedure SetActiveWin32GUI(page: word);
- begin
- end;
- function queryadapterinfo : pmodeinfo;
- var
- mode: TModeInfo;
- ScreenWidth,ScreenHeight : longint;
- ScreenWidthMaximized,ScreenHeightMaximized : longint;
- procedure SetupWin32GUIDefault;
- begin
- mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixel16Win32GUI;
- mode.PutPixel:={$ifdef fpc}@{$endif}PutPixel16Win32GUI;
- mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16Win32GUI;
- mode.HLine := {$ifdef fpc}@{$endif}HLine16Win32GUI;
- mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteWin32GUI;
- mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteWin32GUI;
- mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualWin32GUI;
- mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveWin32GUI;
- mode.InitMode := {$ifdef fpc}@{$endif}InitWin32GUI16colors;
- mode.OuttextXY:={$ifdef fpc}@{$endif}OuttextXYWin32GUI;
- mode.VLine := {$ifdef fpc}@{$endif}VLine16Win32GUI;
- // mode.circle := {$ifdef fpc}@{$endif}Circle16Win32GUI;
- // doesn't work yet
- // mode.Line:={$ifdef fpc}@{$endif}LineWin32GUI;
- end;
- begin
- SaveVideoState:={$ifdef fpc}@{$endif}savestate;
- RestoreVideoState:={$ifdef fpc}@{$endif}restorestate;
- { we must take care of the border and caption }
- ScreenWidth:=GetSystemMetrics(SM_CXSCREEN)-
- 2*GetSystemMetrics(SM_CXFRAME);
- ScreenHeight:=GetSystemMetrics(SM_CYSCREEN)-
- 2*GetSystemMetrics(SM_CYFRAME)-
- GetSystemMetrics(SM_CYCAPTION);
- { for maximozed windows it's again different }
- { here we've only a caption }
- ScreenWidthMaximized:=GetSystemMetrics(SM_CXFULLSCREEN);
- { neither GetSystemMetrics(SM_CYFULLSCREEN nor }
- { SystemParametersInfo(SPI_GETWORKAREA) }
- { takes a hidden try into account :( FK }
- ScreenHeightMaximized:=GetSystemMetrics(SM_CYFULLSCREEN);
- QueryAdapterInfo := ModeList;
- { If the mode listing already exists... }
- { simply return it, without changing }
- { anything... }
- if assigned(ModeList) then
- exit;
- { the first one becomes the standard mode }
- if (ScreenWidth>=640) and (ScreenHeight>=480) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGAHi;
- mode.ModeName:='640 x 480 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 479;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=200) then
- begin
- InitMode(mode);
- { now add all standard VGA modes... }
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGALo;
- mode.ModeName:='640 x 200 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 199;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=350) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VGA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=VGAMed;
- mode.ModeName:='640 x 350 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 349;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=400) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m640x400x256;
- mode.ModeName:='640 x 400 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 399;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- if (ScreenWidth>=640) and (ScreenHeight>=480) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m640x480x256;
- mode.ModeName:='640 x 480 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 639;
- mode.MaxY := 479;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { add 800x600 only if screen is large enough }
- If (ScreenWidth>=800) and (ScreenHeight>=600) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m800x600x16;
- mode.ModeName:='800 x 600 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m800x600x256;
- mode.ModeName:='800 x 600 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 799;
- mode.MaxY := 599;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { add 1024x768 only if screen is large enough }
- If (ScreenWidth>=1024) and (ScreenHeight>=768) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1024x768x16;
- mode.ModeName:='1024 x 768 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1023;
- mode.MaxY := 767;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1024x768x256;
- mode.ModeName:='1024 x 768 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1023;
- mode.MaxY := 768;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { add 1280x1024 only if screen is large enough }
- If (ScreenWidth>=1280) and (ScreenHeight>=1024) then
- begin
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1280x1024x16;
- mode.ModeName:='1280 x 1024 x 16 Win32GUI';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=m1280x1024x256;
- mode.ModeName:='1280 x 1024 x 256 Win32GUI';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := 1279;
- mode.MaxY := 1023;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- { at least we add a mode with the largest possible window }
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mLargestWindow16;
- mode.ModeName:='Largest Window x 16';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidth-1;
- mode.MaxY := ScreenHeight-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mLargestWindow256;
- mode.ModeName:='Largest Window x 256';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidth-1;
- mode.MaxY := ScreenHeight-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- { .. and a maximized window }
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mMaximizedWindow16;
- mode.ModeName:='Maximized Window x 16';
- mode.MaxColor := 16;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidthMaximized-1;
- mode.MaxY := ScreenHeightMaximized-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- InitMode(mode);
- mode.DriverNumber:= VESA;
- mode.HardwarePages:= 0;
- mode.ModeNumber:=mMaximizedWindow256;
- mode.ModeName:='Maximized Window x 256';
- mode.MaxColor := 256;
- mode.PaletteSize := mode.MaxColor;
- mode.DirectColor := FALSE;
- mode.MaxX := ScreenWidthMaximized-1;
- mode.MaxY := ScreenHeightMaximized-1;
- SetupWin32GUIDefault;
- mode.XAspect := 10000;
- mode.YAspect := 10000;
- AddMode(mode);
- end;
- begin
- InitializeGraph;
- charmessagehandler:=nil;
- mousemessagehandler:=nil;
- commandmessagehandler:=nil;
- notifymessagehandler:=nil;
- OnGraphWindowCreation:=nil;
- end.
- {
- $Log$
- Revision 1.7 2001-06-06 17:20:22 jonas
- * fixed wrong typed constant procvars in preparation of my fix which will
- disallow them in FPC mode (plus some other unmerged changes since
- LAST_MERGE)
- Revision 1.6 2001/04/16 10:57:05 peter
- * stricter compiler fixes
- Revision 1.5 2000/12/19 11:59:12 michael
- * Fixes from Peter
- Revision 1.4 2000/11/14 19:45:08 florian
- * child window destruction fixed
- Revision 1.3 2000/10/21 18:20:17 florian
- * a lot of small changes:
- - setlength is internal
- - win32 graph unit extended
- ....
- Revision 1.2 2000/07/13 11:33:57 michael
- + removed logs
- <<<<<<< graph.pp
- }
- =======
- Revision 1.1 1999/11/03 20:23:02 florian
- + first release of win32 gui support
- }
- >>>>>>> 1.1.2.1
|